home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / jcontrol.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  65 lines
  1. ;;; Copyright (c) 1993 by Olin Shivers.
  2. ;;; Job control code.
  3.  
  4. ;;; Fork off a process that runs in its own process group. The process
  5. ;;; is (1) placed in its own process group and (2) suspended before
  6. ;;; the process's actual work code is executed, and before FORK-JOB
  7. ;;; returns to the parent. The next time the job is resumed, it will
  8. ;;; begin its actual work.
  9.  
  10. (define (fork-job . maybe-thunk)
  11.   (let ((child (fork)))
  12.  
  13.     (cond (child
  14.        ;; PARENT -- wait for child to stop and then set its proc group.
  15.        (let ((status (wait child wait/stopped-children)))
  16.          (if (not (status:stop-sig status)) ; Make sure it didn't die.
  17.          (error "premature job death" status))) ; error call right?
  18.        (set-process-group child child))
  19.  
  20.       ;; CHILD -- suspend until we are put in our own proc group.
  21.       ;; The test&suspend isn't atomic; the parent needs to do things
  22.       ;; in the right order to make this win.
  23.       (else    (let lp ()
  24.           (signal-process 0 signal/stop)
  25.           (if (not (= (pid) (process-group))) (lp)))
  26.  
  27.         (if (pair? maybe-thunk)
  28.             (call-terminally (car maybe-thunk)))))
  29.  
  30.     child))
  31.  
  32.  
  33. ;;; Foreground a suspended or running background job.
  34.  
  35. (define (resume-job proc-group)
  36.   (set-terminal-proc-group 0 proc-group)    ; Give tty to job.
  37.   (signal-process-group proc-group signal/cont)
  38.   (let ((status (wait proc-group wait/stopped-children)))
  39.     (set-terminal-proc-group 0 (process-group))    ; Take tty back.
  40.     status))
  41.  
  42. ;;; What if stdin (fd 0) isn't a tty? Need a (control-tty) 
  43. ;;; or (control-tty-fdes) procedure.
  44.  
  45.  
  46. ;;; Background a suspended job.
  47.  
  48. (define (background-job proc-group)
  49.   (signal-process-group proc-group signal/cont)
  50.   proc-group)
  51.  
  52.  
  53. (define-simple-syntax (run . epf)
  54.   (resume-job (fork-job (lambda () (exec-epf . epf)))))
  55.  
  56. (define-simple-syntax (& . epf)
  57.   (background-job (fork-job (lambda () (exec-epf . epf)))))
  58.  
  59.  
  60. ;;; Need repl loop that manages some kind of a job table, 
  61. ;;; and grabs the terminal back after running a job.
  62. ;;; Should I define a WAIT-JOB procedure?
  63. ;;; Need a (CONTROL-TTY) procedure.
  64.  
  65.